home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
batchut
/
batmakr2.zip
/
BATMAKER.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-12-14
|
15KB
|
393 lines
program BATMAKER;
{------------------------------------------------------------------------------
BATMAKER version 2.00 R.L. Miller
Program to read file names from a disk directory, and put them into a
batch file called NAMES.BAT. Several formats are supported: see accompanying
file, BATMAKER.DOC.
>>> Turbo Database Toolbox needed to compile this program. <<<
BATMAKER uses MSDos to get file names from an IBM formated diskette.
The function calls used can be found in the DOS Technical Reference Manual.
This program uses the current Data Transfer Area ( DTA ) in the variables
DTAseg and DTAofs.
------------------------------------------------------------------------------}
{$I-,U+,C+,V-}
const
Scrful = 20;
type { TYPE declarations }
Registers =
record { register pack used in MSDos call }
AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
end;
Char80arr = array [ 1..80 ] of Char;
String80 = string[ 80 ];
BigString = string[255];
CommandString = string[127];
sptr = ^BigString;
var { VARIABLE declarations }
DTA : array [ 1..43 ] of Byte; { Data Transfer Area Buffer }
DTAseg, { DTA Segment before exicution }
DTAofs, { DTA Offset " " }
SetDTAseg, { DTA Segment and Offset set after }
SetDTAofs, { start of program }
Error, { Error return }
I, J, { used as counters }
Option : Integer; { used to specify file types }
Regs : registers; { register pack for the DOS call }
Buffer, { generic Buffer }
Fname : String80; { file name }
Afn : Char80arr; { file Mask: "Ambiguous File Name" }
Lines : Integer; { no. lines on screen already }
Status: Integer; { Status number returned by TurboSort }
ComLine : CommandString; { COPY of invoking Command line, for parsing}
CL : CommandString absolute CSEG:$80; {ACTUAL command line string }
OutFile : text; { File handle for NAMES.BAT, the output file}
Opt : string[3]; {Option string}
Delim : string[20];
FirstWord,NextWord,NewWord : string[80];
FlagWords : string[255];
start, next : integer;
strptr : sptr;
(**************************************************************************)
(* *)
(* NOTICE NOTICE NOTICE NOTICE NOTICE NOTICE NOTICE *)
(* *)
(* Turbo Database Toolbox needed to compile this program! *)
(* *)
(**************************************************************************)
{$ISORT.BOX}
{-----------------------------------------------------------------------------
SetLen: sets length of ASCIZ string passed to it as a parameter.
------------------------------------------------------------------------------}
Procedure SetLen(var ST: bigstring);
Const
MAX : Char = #255;
var
Segment,Offset : Integer;
Terminator : Integer;
Null : String[2];
Begin
Null := #0;
ST[0] := MAX; { Initially set length to Max }
Terminator := Pos(null,ST) - 1;
ST[0] := Chr(Lo(Terminator));
end; {of proc SetLen}
{----------------------------------------------------------------------------
PrtPath: prints out full path string (including drive name).
-----------------------------------------------------------------------------}
Procedure PrtPath;
Const
Carry = $0001;
Var
Disk : String[4];
Path : String[80];
Ichar : Integer;
Pathseg,Pathofs : integer;
Begin
Regs.AX := $1900; { Set up for "Current Disk" DOS call }
MSDOS( Regs);
Ichar := Lo(Regs.AX) + $41;
Disk := Chr(Ichar);
Disk := Disk + ':';
{ Now set up for "Return Text of Current Directory" DOS call }
Regs.DX := 0;
Regs.AX := $4700;
Regs.DS := Seg(path);
Regs.SI := ofs(Path) + 1;
Pathseg := Regs.DS;
Pathofs := Regs.SI;
MSDOS( Regs);
Error := Regs.Flags and Carry;
{$V-}
Setlen(Path); { Turn path string into something familiar to Turbo }
Writeln(' Reading Directory of: ',Disk+Buffer);
Writeln(' (Current directory is: ',Disk+'\'+Path,')');
Writeln;
End; {of proc PrtPath}
{------------------------------------------------------------------------------
GetDTA is used to get the current Disk Transfer Area ( DTA )
address. A function code of $2F is stored in the high Byte of the AX
register and a call to the MSDos INT 21H is made, by using the "Intr"
procedure with a $21 specification for the interrupt.
------------------------------------------------------------------------------}
procedure GetDTA( var Segment, Offset : Integer;
var Error : Integer );
begin
Regs.AX := $2F00; { Function used to get current DTA address }
{ $2F00 is used instead of $2F shl 8 to save
three assembly instructions. An idea for
optimization. }
Intr( $21, Regs ); { Execute MSDos function request }
Segment := Regs.ES; { Segment of DTA returned by DOS }
Offset := Regs.BX; { Offset of DTA returned }
Error := Regs.AX and $FF;
end; { of proc GetDTA }
{------------------------------------------------------------------------------
GetFirst gets the first directory entry of a particular file Mask. The
Afn is passed as a parameter 'Afn' and, the Option was previosly specified
in the SpecifyOption procedure.
------------------------------------------------------------------------------}
procedure GetFirst( Afn : Char80arr; var Fname : String80;
Segment, Offset : Integer; Option : Integer;
var Error : Integer );
var
I : Integer;
begin
Error := 0;
Regs.AX := $4E00; { Get first directory entry }
Regs.DS := Seg( Afn ); { Point to the file Mask }
Regs.DX := Ofs( Afn );
Regs.CX := Option; { Store the Option }
MSDos( Regs ); { Execute MSDos call }
Error := Regs.AX and $FF; { Get Error return }
strptr := ptr(segment, offset+29);
setlen( strptr^);
Fname := strptr^;
end; { of proc GetFirst }
{------------------------------------------------------------------------------
GetNext uses the first bytes of the DTA for the file Mask, and
returns the next file entry on disk corresponding to the file Mask.
------------------------------------------------------------------------------}
procedure GetNext( var Fname : String80; Segment, Offset : Integer;
Option : Integer; var Error : Integer );
var
I : Integer;
begin
Error := 0;
Regs.AX := $4F00; { Function used to get the next }
{ directory entry }
Regs.CX := Option; { Set the file option }
MSDos( Regs ); { Call MSDos }
Error := Regs.AX and $FF; { get the Error return }
strptr := ptr(segment, offset+29);
setlen( strptr^);
Fname := strptr^;
end; { of proc GetNext }
{===========================================================================
ABORT procedure: Prints out help message & halts program
=============================================================================}
Procedure Abort;
begin
WriteLn('Usage: BATMAKER Filename.Typ -O)ption_Letter');
Writeln;
Writeln('Option_Letter Output ');
Writeln('=============